home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / A-Monthly Disks / (c)aas.d64 / test patterns (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  4KB  |  135 lines
  1. 100 REM TEST PATTERNS (C) COPYRIGHT 1987 WRITTEN BY DENNIS DUNK
  2. 110 REM TEST PATTERNS V1.0  IS AVAILABLE AS SHAREWARE
  3. 120 REM SEND DONATIONS TO: DENNIS DUNK   5357 BRIAR CREST DR. FLINT,MI. 48532
  4. 130 POKE 53280,0:POKE 53281,0
  5. 140 PRINT"[147]   TEST PATTERNS:"
  6. 150 PRINT"      1.  COLOR  BARS"
  7. 160 PRINT"      2.  SOLID COLORS"
  8. 170 PRINT"      3.  DOTS"
  9. 180 PRINT"      4.  CROSSHATCH"
  10. 190 PRINT"      5.  HI-RES PATTERNS"
  11. 200 PRINT"      6.  QUIT"
  12. 210 PRINT"     YOUR CHOICE (1-6) ?   "
  13. 220 GET CH$:IF CH$="" THEN 220
  14. 230 CH=VAL(CH$)
  15. 240 IF CH<1 OR CH>6 THEN 220
  16. 250 PRINT"[145]";TAB(26);CH;""
  17. 260 IF CH=2 OR CH=5 OR CH=6 THEN 300
  18. 270 PRINT"[158]    PRESS ANY KEY WHEN DONE"
  19. 280 FOR J=1 TO 1500:NEXT
  20. 290 PRINT"[145]     PRESS ANY KEY WHEN DONE"
  21. 300 ON CH GOTO 310, 650, 830, 880, 960, 1390
  22. 310 PRINT"[147] WHEN COLOR PATTERN IS COMPLETE:         PRESS A KEY FOR COLOR NAMES"
  23. 320 FOR J=1 TO 1500:NEXT: PRINT"[147]"
  24. 330 PRINT"    [150]    [129]    [158]    [153]        [159]    [154]        [156]    ";:CZ=CZ+1
  25. 340 IF CZ<16 GOTO 330
  26. 350 PRINT"[149]                                        ";:CZ=CZ+1
  27. 360 IF CZ<18 GOTO 350
  28. 370 PRINT"[144]        [151]        [152]        [155]                ";:CZ=CZ+1
  29. 380 IF CZ<24 GOTO 370
  30. 390 PRINT"[144]        [151]        [152]        [155]               [146]";
  31. 400 POKE 2023,160:POKE 56295,1
  32. 410 POKE198,0:WAIT198,1:POKE198,0
  33. 420 SM=1024:DIM CN$(16):SL=SM:F=40:G=4:H=8:A=1:POKE 53272,23
  34. 430 READ CN$:CN=LEN(CN$)
  35. 440 B=ASC(MID$(CN$,A,1)):POKE SL+(D*F),B:A=A+1:D=D+1
  36. 450 IF A<=CN THEN 440
  37. 460 D=0 :E=E+1:A=1:SL=SM+(E*G)
  38. 470 IF E<10 THEN 430
  39. 480 SL=1664
  40. 490 READ CN$:CN=LEN(CN$):A=1:D=0
  41. 500 B=ASC(MID$(CN$,A,1)):POKE SL+D,B:A=A+1:D=D+1
  42. 510 IF A<=CN THEN 500
  43. 520 CW=56016:D=0
  44. 530 POKE CW+(D*F),1:D=D+1
  45. 540 IF D<5 THEN 530
  46. 550 SL=1744
  47. 560 A=1:D=0:E=0
  48. 570 READ CN$:CN=LEN(CN$)
  49. 580 B=ASC(MID$(CN$,A,1)):POKE SL+(D*F),B:A=A+1:D=D+1
  50. 590 IF A<=CN THEN 580
  51. 600 D=0 :E=E+1:A=1:SL=1744+(E*H)
  52. 610 IF E<=4 THEN 570
  53. 620 POKE198,0:WAIT198,1:POKE198,0:POKE 53272,21:CLR:RESTORE:GOTO 130
  54. 630 DATA RED,LT RED,ORANGE,YELLOW,LT GREEN,GREEN,CYAN,LT BLUE,BLUE,PURPLE
  55. 640 DATA BROWN,BLACK,DK GRAY,GRAY,LT GRAY,WHITE
  56. 650 PRINT"[147]   SOLID COLOR PATTERNS:"
  57. 660 PRINT"      1.  RED"
  58. 670 PRINT"      2.  GREEN"
  59. 680 PRINT"      3.  BLUE"
  60. 690 PRINT"      4.  QUIT"
  61. 700 PRINT"     YOUR CHOICE (1-4) ?   "
  62. 710 GET CH$:IF CH$="" THEN 710:CH=VAL(CH$)
  63. 720 CH=VAL(CH$)
  64. 730 IF CH<1 OR CH>4 THEN 710
  65. 740 PRINT"[145]";TAB(26);CH;""
  66. 750 IF CH=4 THEN 780
  67. 760 PRINT"[158]    PRESS ANY KEY WHEN DONE"
  68. 770 FOR J=1 TO 1500:NEXT
  69. 780 ON CH GOTO 790, 800, 810, 1390
  70. 790 PRINT"[147]":POKE 53280,2:POKE 53281,2:GOTO 820
  71. 800 PRINT"[147]":POKE 53280,5:POKE 53281,5:POKE 646,5:GOTO 820
  72. 810 PRINT"[147]":POKE 53280,6:POKE 53281,6:POKE 646,6:GOTO 820
  73. 820 POKE198,0:WAIT198,1:POKE198,0:GOTO 130
  74. 830 PRINT"[147]"
  75. 840 SM=1024:SL=SM:REM SCREEN MEMORY
  76. 850 FOR J=1 TO 500:POKE SL,46:SL=SL+2:NEXT
  77. 860 POKE198,0:WAIT198,1:POKE198,0:IF BH=1 THENRUN
  78. 870 BH=1:POKE 53281,1:POKE646,0: PRINT"[147][144]":GOTO 840
  79. 880 PRINT"[147]"
  80. 890 SM=1024:SL=SM:REM SCREEN MEMORY
  81. 900 FOR J=1 TO 20:POKE SL,66:SL=SL+2:NEXT
  82. 910 FOR J=1 TO 20:POKE SL,91:SL=SL+1:POKE SL,67:SL=SL+1:NEXT
  83. 920 IF SL<1984 THEN 900
  84. 930 FOR J=1 TO 20:POKE SL,66:SL=SL+2:NEXT
  85. 940 POKE198,0:WAIT198,1:POKE198,0:IF BH=1 THENRUN
  86. 950 BH=1:POKE 53281,1:POKE646,0: PRINT"[147][144]":GOTO 890
  87. 960 IF PEEK(828)=160 AND PEEK(829)=0 THEN 1120
  88. 970 I=828:REM ML START
  89. 980 READ L$:N=N+1:IF N=16 THEN 1000
  90. 990 GOTO 980
  91. 1000 READ B:IF B=256 THEN 1120
  92. 1010 POKE I,B:I=I+1:GOTO 1000
  93. 1020 DATA 160,0,162,0,169,1,157,0
  94. 1030 DATA 4,224,255,208,6,238,68,3
  95. 1040 DATA 172,68,3,192,7,208,7,224
  96. 1050 DATA 247,208,3,76,94,3,232,76
  97. 1060 DATA 66,3,160,0,169,255,162,0
  98. 1070 DATA 157,0,32,224,255,208,6,238
  99. 1080 DATA 102,3,172,102,3,192,63,208
  100. 1090 DATA 15,224,64,208,11,169,32,141
  101. 1100 DATA 102,3,169,4,141,68,3,96
  102. 1110 DATA 232,73,238,76,100,3,256
  103. 1120 PRINT"[147]   HI-RES TEST PATTERNS:"
  104. 1130 PRINT"      1.  CROSSHATCH"
  105. 1140 PRINT"      2.  DOTS"
  106. 1150 PRINT"      3.  DOTS 2"
  107. 1160 PRINT"      4.  HORIZONTAL LINES"
  108. 1170 PRINT"      5.  VERTICLE LINES"
  109. 1180 PRINT"      6.  QUIT"
  110. 1190 PRINT"     YOUR CHOICE (1-5) ?   "
  111. 1200 GET CH$:IF CH$="" THEN 1200:CH=VAL(CH$)
  112. 1210 CH=VAL(CH$)
  113. 1220 IF CH<1 OR CH>6 THEN 1200
  114. 1230 PRINT"[145]";TAB(26);CH;""
  115. 1240 IF CH=6 THEN 1280
  116. 1250 PRINT"[158]    PRESS ANY KEY WHEN DONE"
  117. 1260 FOR J=1 TO 1500:NEXT
  118. 1270 PRINT"[145]     PRESS ANY KEY WHEN DONE"
  119. 1280 ON CH GOTO 1290, 1300, 1310, 1320, 1330, 1390
  120. 1290 POKE 865,255:POKE 902,238:GOTO 1340
  121. 1300 POKE 865,17:POKE 902,17:GOTO 1340
  122. 1310 POKE 865,238:POKE 902,17:GOTO 1340
  123. 1320 POKE 865,255:POKE 902,255:GOTO 1340
  124. 1330 POKE 865,17:POKE 902,0:GOTO 1340
  125. 1340 BA=2*4096:POKE53272,PEEK(53272)OR 8:REM BIT MAP AT 8192
  126. 1350 POKE 53265,PEEK(53265) OR 32:REM SET BIT MAP MODE
  127. 1360 SYS 828
  128. 1370 POKE198,0:WAIT198,1:POKE198,0
  129. 1380 POKE 53265,PEEK(53265)AND 223:POKE 53272,21:CLR:RESTORE:GOTO 130
  130. 1390 PRINT"[147] PROGRAM WILL BE GONE...[157][157][157]ARE YOU SURE? (Y/N)"
  131. 1400 GET Q$:IF Q$="" THEN 1400
  132. 1410 IF Q$="N" GOTO 130
  133. 1420 IF Q$="Y" THENPRINT"[147]       RESTARTING COMPUTER":SYS 64738
  134. 1430 GOTO 1390
  135.